;;; w3m-settings.el --- 

;; Copyright 2011 zhjw
;;
;; Author: caipingzeng@gmail.com
;; Version: $Id: w3m.el,v 0.0 2011/04/03 05:34:27 user1 Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'w3m)

;;; Code:

(provide 'w3m-settings)
(eval-when-compile
  (require 'cl))



;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################


(autoload 'w3m-which-command "w3m-util")

(when (w3m-which-command "w3m")
;  (require 'util)
  (require 'w3m)

;   (eal-define-keys-commonly
;    global-map
;    `(("M-M"     w3m-goto-url-new-session)
;      ("C-x M-B" view-w3m-bookmark)
;      ("C-x M-m" switch-to-w3m)))
  (define-key global-map "\M-M" `w3m-goto-url-new-session)
  (define-key global-map "\C-x\M-B" `view-w3m-bookmark)
  (define-key global-map "\C-x\M-m" `switch-to-w3m)
)

(defun w3m-settings ()
  "Settings for `w3m'."
  (defvar w3m-buffer-name-prefix "*w3m" "Name prefix of w3m buffer")
  (defvar w3m-buffer-name (concat w3m-buffer-name-prefix "*") "Name of w3m buffer")
  (defvar w3m-bookmark-buffer-name (concat w3m-buffer-name-prefix "-bookmark*") "Name of w3m buffer")
  (defvar w3m-dir (concat my-emacs-lisps-path "emacs-w3m/") "Dir of w3m.")

  (setq w3m-command-arguments '("-cookie" "-F"))
  (setq w3m-use-cookies t)
  (setq w3m-icon-directory (concat w3m-dir "icons"))
  (setq w3m-use-mule-ucs t)
  (setq w3m-home-page "http://www.google.com.hk/webhp?hl=zh-CN&sourceid=cnhp")
  (setq w3m-default-display-inline-images t)

;   (defun w3m-mode-settings ()
;     (make-local-variable 'hl-line-face)
;     (setq hl-line-face 'hl-line-nonunderline-face)
;     (setq hl-line-overlay nil)
;     (color-theme-adjust-hl-line-face))
; 
;   (add-hook 'w3m-mode-hook 'w3m-mode-settings)

  (defun w3m-save-current-buffer ()
    "Save current w3m buffer."
    (interactive)
    (save-excursion
      (mark-whole-buffer)
      (call-interactively 'copy-region-as-kill-nomark))
    (with-temp-buffer
      (call-interactively 'yank)
      (call-interactively 'write-file)))

  (defun w3m-print-current-url ()
    "Display current url."
    (interactive)
    (w3m-message "%s" (w3m-url-readable-string w3m-current-url)))

  (defun w3m-copy-current-url ()
    "Display the current url in the echo area and put it into `kill-ring'."
    (interactive)
    (when w3m-current-url
      (let ((deactivate-mark nil))
        (kill-new w3m-current-url)
        (w3m-print-current-url))))

  (defun view-w3m-bookmark ()
    "View w3m bokmark."
    (interactive)
    (let ((buffer (get-buffer w3m-bookmark-buffer-name)))
      (if buffer
          (switch-to-buffer buffer)
        (with-current-buffer (get-buffer-create w3m-bookmark-buffer-name)
          (w3m-mode)
          (w3m-bookmark-view)))))

  (defun switch-to-w3m ()
    "Switch to *w3m* buffer."
    (interactive)
    (let ((buffer (get-buffer w3m-buffer-name)))
      (if buffer
          (switch-to-buffer buffer)
        (message "Could not found w3m buffer."))))

  (defun w3m-browse-buffer (&optional buffer)
    "Use w3m browser buffer BUFFER."
    (interactive "bBuffer to browse use w3m: ")
    (unless buffer (setq buffer (current-buffer)))
    (let* ((file (buffer-file-name buffer))
           (name (buffer-name buffer)))
      (if file
          (w3m-goto-url-new-session file)
        (with-current-buffer buffer
          (save-excursion
            (mark-whole-buffer)
            (call-interactively 'copy-region-as-kill-nomark)))
        (let* ((new-name
                (concat
                 w3m-buffer-name-prefix
                 "-"
                 (if (string= "*" (substring name 0 1))
                     (substring name 1)
                   (concat name "*"))))
               (new-buffer (get-buffer-create new-name)))
          (switch-to-buffer new-buffer)
          (call-interactively 'yank)
          (w3m-buffer)
          (w3m-mode)
          (setq w3m-current-title (buffer-name))))))

  ;; fix small bug about of `w3m-auto-show'
  ;; see my-blog/emacs/w3m-auto-show-bug.htm
  (defun w3m-auto-show ()
    "Scroll horizontally so that the point is visible."
    (when (and truncate-lines
               w3m-auto-show
               (not w3m-horizontal-scroll-done)
               (not (and (eq last-command this-command)
                         (or (eq (point) (point-min))
                             (eq (point) (point-max)))))
               (or (memq this-command '(beginning-of-buffer end-of-buffer))
                   (string-match "\\`i?search-"
                                 (if (symbolp this-command) (symbol-name this-command) ""))
                   (and (markerp (nth 1 w3m-current-position))
                        (markerp (nth 2 w3m-current-position))
                        (>= (point)
                            (marker-position (nth 1 w3m-current-position)))
                        (<= (point)
                            (marker-position (nth 2 w3m-current-position))))))
      (w3m-horizontal-on-screen))
    (setq w3m-horizontal-scroll-done nil))

  (defun w3m-link-numbering (&rest args)
    "Make overlays that display link numbers."
    (when w3m-link-numbering-mode
      (save-excursion
        (goto-char (point-min))
        (let ((i 0)
              overlay num)
          (catch 'already-numbered
            (while (w3m-goto-next-anchor)
              (when (get-char-property (point) 'w3m-link-numbering-overlay)
                (throw 'already-numbered nil))
              (setq overlay (make-overlay (point) (1+ (point)))
                    num (format "[%d]" (incf i)))
              (w3m-static-if (featurep 'xemacs)
                  (progn
                    (overlay-put overlay 'before-string num)
                    (set-glyph-face (extent-begin-glyph overlay)
                                    'w3m-link-numbering))
                (w3m-add-face-property 0 (length num) 'w3m-link-numbering num)
                (overlay-put overlay 'before-string num)
                (overlay-put overlay 'evaporate t))
              (overlay-put overlay 'w3m-link-numbering-overlay i)))))))

;   (eal-define-keys
;    'w3m-mode-map
;    `(("<backtab>" w3m-previous-anchor)
;      ("n"         w3m-next-anchor)
;      ("p"         w3m-previous-anchor)
;      ("w"         w3m-next-form)
;      ("b"         w3m-previous-form)
;      ("f"         w3m-go-to-linknum)
;      ("M-n"       w3m-next-buffer)
;      ("M-p"       w3m-previous-buffer)
;      ("C-k"       kill-this-buffer)
;      ("C-k"       w3m-delete-buffer)
;      ("C-c 1"     w3m-delete-other-buffers)
;      ("1"         delete-other-windows)
;      ("C-x C-s"   w3m-save-current-buffer-sb)
;      ("P"         w3m-print-current-url)
;      ("U"         w3m-print-this-url)
;      ("c"         w3m-copy-current-url)
;      ("g"         w3m-goto-url-new-session)
;      ("G"         w3m-goto-url)
;      ("d"         w3m-download-this-url-sb)
;      ("M-d"       w3m-download-sb)
;      ("s"         w3m-search)
;      ("S"         w3m-history)
;      ("u"         View-scroll-page-backward)
;      ("J"         roll-down)
;      ("K"         roll-up)
;      ("o"         other-window)
;      ("m"         w3m-view-this-url-new-session)
;      ("C-h"       w3m-view-previous-page)
;      ("F"         w3m-view-next-page)
;      ("C-;"       w3m-view-next-page)
;      ("r"         w3m-reload-this-page)
;      ("v"         w3m-bookmark-view-new-session)
;      ("M-e"       w3m-bookmark-edit)
;      ("'"         switch-to-other-buffer)))

  (add-hook `w3m-mode-hook `w3m-custom-map-hook)
  (defun w3m-custom-map-hook ()
;	(local-set-key "<backtab>" `w3m-previous-anchor)
	(local-set-key "p" `w3m-previous-anchor)
	(local-set-key "n" `w3m-next-anchor)
	(local-set-key "w" `w3m-next-form)
	(local-set-key "b" `w3m-previous-form)
	(local-set-key "f" `w3m-go-to-linknum)
 	(local-set-key "\M-n" `w3m-next-buffer)
 	(local-set-key "\M-p" `w3m-previous-buffer)
 	(local-set-key "\C-k" `kill-this-buffer)
;	(local-set-key [(control k)] `kill-this-buffer)
; 	(local-set-key "\C-k" `w3m-delete-buffer)
	(local-set-key "\C-c1" `w3m-delete-other-buffers)
	(local-set-key "1" `delete-other-windows)
 	(local-set-key "\C-x\C-s" `w3m-save-current-buffer-sb)
	(local-set-key "P" `w3m-print-current-url)
	(local-set-key "U" `w3m-print-this-url)
	(local-set-key "c" `w3m-copy-current-url)
	(local-set-key "g" `w3m-goto-url-new-session)
	(local-set-key "G" `w3m-goto-url)
	(local-set-key "d" `w3m-download-this-url-sb)
 	(local-set-key "\M-d" `w3m-download-sb)
	(local-set-key "s" `w3m-search)
	(local-set-key "S" `w3m-history)
	(local-set-key "u" `View-scroll-page-backward)
	(local-set-key "J" `roll-down)
	(local-set-key "K" `roll-up)
	(local-set-key "o" `other-window)
	(local-set-key "m" `w3m-view-this-url-new-session)
 	(local-set-key "\C-h" `w3m-view-previous-page)
	(local-set-key "F" `w3m-view-next-page)
; 	(local-set-key "\C-;" `w3m-view-next-page) ;用这个设置会报错！
	(local-set-key [(control \;)] `w3m-view-next-page)
	(local-set-key "r" `w3m-reload-this-page)
	(local-set-key "v" `w3m-bookmark-view-new-session)
	(local-set-key "\M-e" `w3m-bookmark-edit)
	(local-set-key "'" `switch-to-other-buffer)
	)
)

(eval-after-load "w3m"
  `(w3m-settings))

;;; w3m.el ends here
